home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magic Illusions
/
Magic Illusions (1995)(GTI - Schatztruhe)[!].iso
/
MSDOS
/
TOOLS
/
ANSI
/
SANSI.BAS
< prev
next >
Wrap
BASIC Source File
|
1994-08-07
|
6KB
|
187 lines
DECLARE SUB MakePat (Zw$, ZwF%, ZwB%)
DECLARE SUB MakeANSI (offen%)
DECLARE FUNCTION InsPat$ (Zahl%)
DECLARE FUNCTION PosOK% (Up%, Max%)
DECLARE SUB MakeSITS (eingabe$, laenge%)
CONST MaxEin = 70
CONST MaxAus = 80
DIM zeile AS STRING * MaxEin
DIM SHARED Result AS STRING * MaxAus
DIM SHARED ResultF(MaxAus + 1), ResultB(MaxAus + 1) AS INTEGER
DIM minpat AS INTEGER
DIM Patlen AS INTEGER
DIM veil AS INTEGER
RANDOMIZE TIMER
CONST maxpat = 10
CONST Zeichen = "°±²Û"
CONST Zeichenk = 4
CONST FColor = 16
CONST BColor = 8
CLS
PRINT " SANSI V111.111á"
PRINT " (c) Arndt Grass"
PRINT : PRINT
INPUT "Filename"; datei$
INPUT "Wie soll die ANSI-Ausgabedatei heiáen"; ausdatei$
ausdatei$ = "c:\qb4\" + ausdatei$
datei$ = "c:\qb4\" + datei$
OPEN datei$ FOR INPUT AS #1
veil = FREEFILE
OPEN ausdatei$ FOR OUTPUT AS veil
INPUT #1, identi$
IF LEFT$(identi$, 3) <> "SAS" THEN
PRINT "Wrong Inputfile, Dude!!!"
CLOSE
END
ELSE
minpat = (VAL(MID$(identi$, 5, 1)) + 1) * 2
END IF
IF MID$(identi$, 6, 1) = ":" THEN
pat$ = MID$(identi$, 7, 10)
END IF
DO
PRINT "Wie lang soll das Pattern gewhlt werden (min."; minpat; " max."; maxpat; ")";
INPUT Patlen
LOOP UNTIL (Patlen <= maxpat) AND (Patlen >= minpat)
WHILE NOT EOF(1)
LINE INPUT #1, zeile
Result = ""
FOR i = 1 TO MaxAus
ResultF(i) = 0
ResultB(i) = 0
NEXT i
CALL MakeSITS(zeile, Patlen)
CALL MakeANSI(veil)
REM PRINT Result
WEND
CLOSE
CLS
SHELL "type " + ausdatei$
DO: LOOP UNTIL INKEY$ <> ""
END
SUB delpat (pattern$, PatPosition%, Aktuell%, change%)
FOR i = 1 TO change%
IF PatPosition% = Aktuell% THEN
pattern$ = LEFT$(pattern$, Aktuell% - 1)
Aktuell% = Aktuell% - 1
PatPosition% = PosOK%(PatPosition%, Aktuell%)
ELSE
pattern$ = LEFT$(pattern$, PatPosition% - 1) + RIGHT$(pattern$, Aktuell% - PattPosition%)
Aktuell% = Aktuell% - 1
END IF
NEXT i
END SUB
FUNCTION InsPat$ (Zahl%)
Zw$ = ""
FOR i = 1 TO Zahl%
Zw$ = Zw$ + CHR$(Start + INT(Ende * RND))
NEXT i
InsPat$ = Zw$
END FUNCTION
SUB MakeANSI (offen%)
FOR i = 1 TO LEN(Result)
p$ = CHR$(27) + "[0;"
IF ResultF(i) > 7 THEN
p$ = p$ + "1;"
ResultF(i) = ResultF(i) - 8
END IF
p$ = p$ + "3" + CHR$(48 + ResultF(i)) + ";4" + CHR$(48 + ResultB(i)) + "m" + MID$(Result, i, 1)
PRINT #offen%, p$;
NEXT
PRINT #offen%, CHR$(13);
END SUB
SUB MakePat (Zw$, ZwF%, ZwB%)
Zw$ = MID$(Zeichen, INT(Zeichenk * RND) + 1, 1)
ZwB% = INT(RND * BColor)
DO
ZwF% = INT(RND * FColor)
LOOP UNTIL ZwF% <> ZwB%
END SUB
SUB MakeSITS (eingabe$, laenge%)
DIM Vore%(20), Back(20) AS INTEGER
DIM RanDot(20) AS STRING * 1
DIM PatPos AS INTEGER
'Pattern generieren
FOR ii = 1 TO laenge%
CALL MakePat(RanDot(ii), Vore%(ii), Back(ii))
NEXT ii
Aktuell% = laenge%
level% = 0
FOR i = 1 TO Aktuell% 'Leerpattern schreiben
MID$(Result, i) = RanDot(i)
ResultF(i) = Vore%(i)
ResultB(i) = Back(i)
NEXT i
PatPos = 1 'Erste Patternposition festlegen
FOR i = 1 TO LEN(eingabe$) 'Eingabe abarbeiten
a$ = MID$(eingabe$, i, 1)
IF a$ = " " THEN neuLevel% = 0 ELSE neuLevel% = VAL(a$)
IF neuLevel% <> level% THEN
IF level% > neuLevel% THEN
change% = level% - neuLevel%
FOR j = Aktuell% TO PatPos STEP -1
RanDot(j + change%) = RanDot(j)
Vore%(j + change%) = Vore%(j)
Back(j + change%) = Back(j)
NEXT
FOR j = 0 TO change% - 1
RanDot(j + PatPos) = MID$(Zeichen, INT(Zeichenk * RND) + 1, 1)
Back(j + PatPos) = INT(RND * BColor)
DO
Vore%(j + PatPos) = INT(RND * FColor)
LOOP UNTIL Back(j + PatPos) <> Vore%(j + PatPos)
NEXT
Aktuell% = Aktuell% + change%
ELSE 'neulevel kleiner level
change% = neuLevel% - level%
FOR k = 1 TO change%
FOR j = PatPos TO Aktuell% - 1
RanDot(j) = RanDot(j + 1)
Vore%(j) = Vore%(j + 1)
Back(j) = Back(j + 1)
NEXT
Aktuell% = Aktuell% - 1
PatPos = PosOK%(PatPos, Aktuell%)
NEXT k
END IF
level% = neuLevel%
END IF
MID$(Result, i + laenge%) = RanDot(PatPos)
ResultF(i + laenge%) = Vore%(PatPos)
ResultB(i + laenge%) = Back(PatPos)
PatPos = PatPos + 1
PatPos = PosOK%(PatPos, Aktuell%)
NEXT i
END SUB
FUNCTION PosOK% (Up%, Max%)
IF Up% > Max% THEN
PosOK% = 1
ELSE
PosOK% = Up%
END IF
END FUNCTION